home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / lzhsrc97.arc / LZHSRC97.PAS next >
Pascal/Delphi Source File  |  1989-12-18  |  20KB  |  894 lines
  1.  
  2. {This is an LZH compression routine used in BRANCH version 0.97. }
  3. {Most of the code here is adapted from LZHSRC10.???              }
  4. {
  5.   The file LZHUF.C is originally written in C. I have re-written it
  6.   in  PASCAL.
  7. }
  8.  
  9.  
  10. {$M 16384,0,0}
  11. program lzh;
  12. uses dos,crt,mycrt;
  13.  
  14.  
  15. const
  16.   N = 4096;             { Size of string buffer     }
  17.   F = 60;               { Size of look-ahead buffer }
  18.   THRESHOLD = 2;
  19.   NILL = N;                { End of tree's node  }
  20.   TREENODE = N+1;
  21.   EXIT_OK = 0;
  22.   EXIT_FAILED = -1;
  23.  
  24.  
  25.   buffersize=16384;
  26.  
  27.   {**** Huffman coding parameters ****}
  28.  
  29.   N_CHAR = (256 - THRESHOLD + F);  {character code (= 0..N_CHAR-1)}
  30.   T      = (N_CHAR * 2 - 1);       { Size of table }
  31.   R      = (T - 1);                   { root position }
  32.  
  33.   MAX_FREQ    = $8000;
  34.                     {*** update when cumulative frequency ***}
  35.                     {*** reaches to this value ***}
  36.  
  37.  
  38. {**
  39. ***    Tables for encoding/decoding upper 6 bits of
  40. ***    sliding dictionary pointer
  41. ***}
  42.  
  43. {*** encoder table ***}
  44.  
  45. p_len:array[0..63] of byte= (
  46.   $03, $04, $04, $04, $05, $05, $05, $05,
  47.   $05, $05, $05, $05, $06, $06, $06, $06,
  48.   $06, $06, $06, $06, $06, $06, $06, $06,
  49.   $07, $07, $07, $07, $07, $07, $07, $07,
  50.   $07, $07, $07, $07, $07, $07, $07, $07,
  51.   $07, $07, $07, $07, $07, $07, $07, $07,
  52.   $08, $08, $08, $08, $08, $08, $08, $08,
  53.   $08, $08, $08, $08, $08, $08, $08, $08
  54. );
  55.  
  56.  
  57. p_code:array [0..63] of byte = (
  58.     $00, $20, $30, $40, $50, $58, $60, $68,
  59.     $70, $78, $80, $88, $90, $94, $98, $9C,
  60.     $A0, $A4, $A8, $AC, $B0, $B4, $B8, $BC,
  61.     $C0, $C2, $C4, $C6, $C8, $CA, $CC, $CE,
  62.     $D0, $D2, $D4, $D6, $D8, $DA, $DC, $DE,
  63.     $E0, $E2, $E4, $E6, $E8, $EA, $EC, $EE,
  64.     $F0, $F1, $F2, $F3, $F4, $F5, $F6, $F7,
  65.     $F8, $F9, $FA, $FB, $FC, $FD, $FE, $FF
  66. );
  67.  
  68.  
  69. {*** decoder table ***}
  70.  
  71. d_code:array[0..255] of byte = (
  72.     $00, $00, $00, $00, $00, $00, $00, $00,
  73.     $00, $00, $00, $00, $00, $00, $00, $00,
  74.     $00, $00, $00, $00, $00, $00, $00, $00,
  75.     $00, $00, $00, $00, $00, $00, $00, $00,
  76.     $01, $01, $01, $01, $01, $01, $01, $01,
  77.     $01, $01, $01, $01, $01, $01, $01, $01,
  78.     $02, $02, $02, $02, $02, $02, $02, $02,
  79.     $02, $02, $02, $02, $02, $02, $02, $02,
  80.     $03, $03, $03, $03, $03, $03, $03, $03,
  81.     $03, $03, $03, $03, $03, $03, $03, $03,
  82.     $04, $04, $04, $04, $04, $04, $04, $04,
  83.     $05, $05, $05, $05, $05, $05, $05, $05,
  84.     $06, $06, $06, $06, $06, $06, $06, $06,
  85.     $07, $07, $07, $07, $07, $07, $07, $07,
  86.     $08, $08, $08, $08, $08, $08, $08, $08,
  87.     $09, $09, $09, $09, $09, $09, $09, $09,
  88.     $0A, $0A, $0A, $0A, $0A, $0A, $0A, $0A,
  89.     $0B, $0B, $0B, $0B, $0B, $0B, $0B, $0B,
  90.     $0C, $0C, $0C, $0C, $0D, $0D, $0D, $0D,
  91.     $0E, $0E, $0E, $0E, $0F, $0F, $0F, $0F,
  92.     $10, $10, $10, $10, $11, $11, $11, $11,
  93.     $12, $12, $12, $12, $13, $13, $13, $13,
  94.     $14, $14, $14, $14, $15, $15, $15, $15,
  95.     $16, $16, $16, $16, $17, $17, $17, $17,
  96.     $18, $18, $19, $19, $1A, $1A, $1B, $1B,
  97.     $1C, $1C, $1D, $1D, $1E, $1E, $1F, $1F,
  98.     $20, $20, $21, $21, $22, $22, $23, $23,
  99.     $24, $24, $25, $25, $26, $26, $27, $27,
  100.     $28, $28, $29, $29, $2A, $2A, $2B, $2B,
  101.     $2C, $2C, $2D, $2D, $2E, $2E, $2F, $2F,
  102.     $30, $31, $32, $33, $34, $35, $36, $37,
  103.     $38, $39, $3A, $3B, $3C, $3D, $3E, $3F
  104. );
  105.  
  106. d_len:array[0..255] of byte = (
  107.     $03, $03, $03, $03, $03, $03, $03, $03,
  108.     $03, $03, $03, $03, $03, $03, $03, $03,
  109.     $03, $03, $03, $03, $03, $03, $03, $03,
  110.     $03, $03, $03, $03, $03, $03, $03, $03,
  111.     $04, $04, $04, $04, $04, $04, $04, $04,
  112.     $04, $04, $04, $04, $04, $04, $04, $04,
  113.     $04, $04, $04, $04, $04, $04, $04, $04,
  114.     $04, $04, $04, $04, $04, $04, $04, $04,
  115.     $04, $04, $04, $04, $04, $04, $04, $04,
  116.     $04, $04, $04, $04, $04, $04, $04, $04,
  117.     $05, $05, $05, $05, $05, $05, $05, $05,
  118.     $05, $05, $05, $05, $05, $05, $05, $05,
  119.     $05, $05, $05, $05, $05, $05, $05, $05,
  120.     $05, $05, $05, $05, $05, $05, $05, $05,
  121.     $05, $05, $05, $05, $05, $05, $05, $05,
  122.     $05, $05, $05, $05, $05, $05, $05, $05,
  123.     $05, $05, $05, $05, $05, $05, $05, $05,
  124.     $05, $05, $05, $05, $05, $05, $05, $05,
  125.     $06, $06, $06, $06, $06, $06, $06, $06,
  126.     $06, $06, $06, $06, $06, $06, $06, $06,
  127.     $06, $06, $06, $06, $06, $06, $06, $06,
  128.     $06, $06, $06, $06, $06, $06, $06, $06,
  129.     $06, $06, $06, $06, $06, $06, $06, $06,
  130.     $06, $06, $06, $06, $06, $06, $06, $06,
  131.     $07, $07, $07, $07, $07, $07, $07, $07,
  132.     $07, $07, $07, $07, $07, $07, $07, $07,
  133.     $07, $07, $07, $07, $07, $07, $07, $07,
  134.     $07, $07, $07, $07, $07, $07, $07, $07,
  135.     $07, $07, $07, $07, $07, $07, $07, $07,
  136.     $07, $07, $07, $07, $07, $07, $07, $07,
  137.     $08, $08, $08, $08, $08, $08, $08, $08,
  138.     $08, $08, $08, $08, $08, $08, $08, $08
  139. );
  140.  
  141. type
  142.   bytebuffer=array[0..buffersize] of byte;
  143.   bytefile= file of byte;
  144.  
  145.   fileheadertype = record
  146.     Headsize,Headchk:byte;
  147.     HeadID:packed array[1..5] of char;
  148.     Packsize,Origsize,Filetime:longint;
  149.     Attr:word;
  150.     filename:pathstr;
  151.   end;
  152.  
  153. var
  154.   crc:word;
  155.   crcbuf:array[1..2]of byte absolute crc;
  156.   fh:fileheadertype;
  157.   fha:array[1..sizeof(fileheadertype)] of byte absolute fh;
  158.   crc_table:array[0..255] of word;
  159.   text_buf         : array[0..N+F-1] of byte;
  160.   match_position,
  161.   match_length     : integer;
  162.   lson  : array [0..N+1]   of integer;
  163.   rson  : array [0..N+1] of integer;
  164.   eqson : array [0..N+1] of integer;
  165.   dad   : array [0..N+1]   of integer;
  166.   sub_tree:array[0..255]   of integer;
  167.  
  168.  
  169.   useleftnode:boolean;
  170.  
  171.   infile,outfile:bytefile;
  172.   textsize,codesize,printcount:longint;
  173.  
  174.  
  175.   freq  : array[0..T+1] of word;  {**** cumulative freq table ****}
  176.  
  177. {*
  178.  * pointing parent nodes.
  179.  * area [T..(T + N_CHAR - 1)] are pointers for leaves
  180.  *}
  181.  
  182.   prnt:array[0..T+N_CHAR] of integer;
  183.  
  184. {**** pointing children nodes (son[], son[] + 1) ***}
  185.  
  186.   son:array[0..T] of integer;
  187.   getbuf : word;
  188.   getlen : byte;
  189.  
  190.   putbuf : word;
  191.   putlen : byte;
  192.  
  193.   code, len : word;
  194.  
  195.  
  196.   outfilename,infilename:pathstr;
  197.  
  198. function freadbyte:integer;
  199. var b:byte;
  200. begin
  201.   read(infile,b);
  202.   freadbyte:=b;
  203. end;
  204.  
  205. procedure fwritebyte(b:byte);
  206. begin
  207.   write(outfile,b);
  208. end;
  209.  
  210.  
  211. procedure freadlong(var ll:longint);
  212. var
  213.   lla:array[1..4] of byte absolute ll;
  214.   i:integer;
  215. begin
  216.   for i:=1 to 4 do
  217.     lla[i]:=freadbyte;
  218. end;
  219.  
  220. procedure fwritelong(ll:longint);
  221. var
  222.   lla:array[1..4] of byte absolute ll;
  223.   i:integer;
  224. begin
  225.   for i:=1 to 4 do
  226.     fwritebyte(lla[i]);
  227. end;
  228.  
  229.  
  230. procedure InitTree;              { *** Initializing tree *** }
  231. var
  232.   i:integer;
  233. begin
  234.  
  235.   for i := 0 to 255 do
  236.     sub_tree[i] := NILL;            {**** root ****}
  237.  
  238.   for i := 0 to N-1 do
  239.     dad[i] := NILL;                {**** node ****}
  240.  
  241. end;
  242.  
  243.   function  searchtree(r:integer):boolean;
  244.   var
  245.     x,match_value:word;
  246.     p:integer;
  247.   begin
  248.     searchtree:=false;
  249.     match_value:=text_buf[r+1]+text_buf[r+2]*256;
  250.     p:=sub_tree[text_buf[r]];
  251.     match_position:=NILL;
  252.  
  253.     while p<>NILL do
  254.       begin
  255.         match_position:=p;
  256.         x:=text_buf[p+1]+text_buf[p+2]*256;
  257.         if match_value=x then
  258.           begin
  259.             searchtree:=true;
  260.             exit;
  261.           end;
  262.         if x>match_value then
  263.           begin
  264.             useleftnode:=false;
  265.             p:=rson[p];
  266.           end
  267.         else
  268.           begin
  269.             useleftnode:=true;
  270.             p:=lson[p];
  271.           end;
  272.       end;
  273.   end;
  274.  
  275.  
  276.  
  277.   procedure insertnode(r:integer);
  278.   var
  279.     parent :word;
  280.     p:word;
  281.     i,curr_position:integer;
  282.  
  283.   begin
  284.  
  285.     if searchtree(r) then
  286.       begin
  287.         eqson[r]:=match_position;
  288.         dad[r]  :=dad[match_position];
  289.         dad[match_position]:=r;
  290.  
  291.         rson[r]:=rson[match_position];
  292.         if rson[r]<>NILL then dad[rson[r]]:=r;
  293.  
  294.         lson[r]:=lson[match_position];
  295.         if lson[r]<>NILL then dad[lson[r]]:=r;
  296.  
  297.         p:=dad[r];
  298.         if p=TREENODE then
  299.           sub_tree[text_buf[r]]:=r
  300.         else
  301.           begin
  302.             if rson[p]=match_position then rson[p]:=r
  303.             else lson[p]:=r;
  304.           end;
  305.  
  306.         curr_position:=match_position;
  307.         match_length:=0;
  308.  
  309.         repeat
  310.           i:=3;
  311.           while i<F do
  312.             begin
  313.               if text_buf[curr_position+i]=text_buf[r+i] then
  314.                 inc(i)
  315.               else
  316.                 begin
  317.                   if i>match_length then
  318.                     begin
  319.                       match_length:=i;
  320.                       match_position:=curr_position;
  321.                     end;
  322.                   i:=N;
  323.                 end;
  324.               if i=F then
  325.                 begin
  326.  
  327.                   match_length:=i;
  328.                   match_position:=curr_position;
  329.                   exit;
  330.  
  331.                 end;
  332.             end;
  333.           curr_position:=eqson[curr_position];
  334.         until curr_position=NILL;
  335.  
  336.         exit;
  337.       end;
  338.  
  339.     parent:=match_position;
  340.     if parent=NILL then
  341.       begin
  342.         sub_tree[text_buf[r]]:=r;
  343.         parent:=TREENODE;
  344.       end
  345.     else
  346.       begin
  347.         if useleftnode then lson[parent]:=r
  348.         else rson[parent]:=r;
  349.  
  350.       end;
  351.  
  352.     lson[r]:=NILL;
  353.     rson[r]:=NILL;
  354.     eqson[r]:=NILL;
  355.     dad[r]:=parent;
  356.     match_position:=NILL;
  357.     match_length  :=0;
  358.   end;
  359.  
  360.  
  361.  
  362.   procedure deletenode(p:integer);
  363.   var
  364.     q:integer;
  365.   begin
  366.  
  367.     if (dad[p]=NILL) then exit;
  368.  
  369.     if (dad[p]<>TREENODE)and(eqson[dad[p]]=p) then
  370.       begin
  371.         q:=eqson[p];
  372.         eqson[dad[p]]:=q;
  373.         if q<>NILL then dad[q]:=dad[p];
  374.         exit;
  375.       end;
  376.  
  377.  
  378.     if rson[p]=NILL then q:=lson[p]
  379.     else if lson[p]=NILL then q:=rson[p]
  380.     else
  381.       begin
  382.         q:=lson[p];
  383.         if rson[q]<>NILL then
  384.           begin
  385.             repeat
  386.               q:=rson[q];
  387.             until  rson[q]=NILL;
  388.             rson[dad[q]]:=lson[q];
  389.             dad[lson[q]]:=dad[q];
  390.             lson[q]:=lson[p];
  391.             dad[lson[p]]:=q;
  392.           end;
  393.         rson[q]:=rson[p];
  394.         dad[rson[p]]:=q;
  395.       end;
  396.  
  397.     dad[q]:=dad[p];
  398.     if dad[p]<>TREENODE then
  399.       begin
  400.         if rson[dad[p]]=p then rson[dad[p]]:=q
  401.         else lson[dad[p]]:=q;
  402.       end
  403.     else
  404.       begin
  405.         sub_tree[text_buf[p]]:=q;
  406.       end;
  407.     dad[p]:=NILL
  408.   end;
  409.  
  410.  
  411.  
  412. function GetBit:integer;        {**** get one bit ****}
  413. var
  414.   i:integer;
  415. begin
  416.   while (getlen <= 8) do
  417.     begin
  418.       i:=freadbyte;
  419.       if (i  < 0)
  420.         then i := 0;
  421.  
  422.       getbuf := getbuf or (i shl (8 - getlen));
  423.       getlen := getlen + 8;
  424.     end;
  425.   i := getbuf;
  426.   getbuf := getbuf shl 1;
  427.   dec(getlen);
  428.   Getbit:= integer(i < 0);
  429. end;
  430.  
  431.  
  432.  
  433. function GetByte:integer;    {**** get a byte ****}
  434. {^^ 1 times}
  435. var
  436.   i:word;
  437. begin
  438.  
  439.     while (getlen <= 8) do
  440.       begin
  441.         i:=freadbyte;
  442.         if (i < 0)  then i := 0;
  443.         getbuf := getbuf or (i shl (8 - getlen));
  444.         getlen := getlen + 8;
  445.       end;
  446.  
  447.     i := getbuf;
  448.     getbuf := getbuf shl 8;
  449.     getlen := getlen - 8;
  450.  
  451.     Getbyte :=i shr 8;
  452. end;
  453.  
  454.  
  455. procedure Putcode(l:integer ;  c:word);        {**** output c bits ****}
  456. begin
  457.     putbuf := putbuf or (c shr putlen);
  458.     putlen := putlen + l;
  459.     if (putlen  >= 8) then
  460.       begin
  461.         fwritebyte(putbuf shr 8);
  462.         putlen := putlen - 8;
  463.         if (putlen >= 8) then
  464.           begin
  465.             fwritebyte(putbuf);
  466.             codesize := codesize + 2;
  467.             putlen := putlen - 8;
  468.             putbuf := c shl (l - putlen);
  469.           end
  470.         else
  471.           begin
  472.             putbuf := putbuf shl 8;
  473.             codesize:=codesize+1;
  474.           end;
  475.       end;
  476. end;
  477.  
  478.  
  479. {**** initialize freq tree ****}
  480.  
  481. procedure StartHuff;
  482. var
  483.   i,j:integer;
  484. begin
  485.  
  486.     for i := 0 to N_CHAR-1 do
  487.       begin
  488.         freq[i] := 1;
  489.         son[i]  := i + T;
  490.         prnt[i + T] := i;
  491.       end;
  492.     i := 0;
  493.     j := N_CHAR;
  494.  
  495.     while (j <= R) do
  496.       begin
  497.         freq[j] := freq[i] + freq[i + 1];
  498.         son[j]  := i;
  499.         prnt[i] := j;
  500.         prnt[i + 1] := j;
  501.         i := i + 2;
  502.         j:=j+1;
  503.       end;
  504.  
  505.     freq[T] := $ffff;
  506.     prnt[R] := 0;
  507.  
  508. end;
  509.  
  510.  
  511. {**** reconstruct freq tree ****}
  512.  
  513. procedure reconst;
  514. var
  515.   i,j,k:integer;
  516.   f,l:word;
  517. begin
  518.  
  519.     {**** halven cumulative freq for leaf nodes ****}
  520.     j := 0;
  521.     for i := 0 to T-1 do
  522.       begin
  523.         if (son[i] >= T) then
  524.           begin
  525.             freq[j] := (freq[i] + 1) div 2;
  526.             son[j] := son[i];
  527.             j:=j+1;
  528.           end;
  529.       end;
  530.  
  531.     {**** make a tree : first, connect children nodes ****}
  532.  
  533.     i:=0;
  534.     for j:=N_CHAR to T-1 do
  535.       begin
  536.         k := i + 1;
  537.         f := freq[i] + freq[k];
  538.         freq[j] := freq[i] + freq[k];
  539.         k:=j-1;
  540.         while (f<freq[k]) do
  541.           begin
  542.             k:=k-1;
  543.           end;
  544.  
  545.         k:=k+1;
  546.         l := (j - k) * 2;
  547.  
  548.  
  549.         move(freq[k],freq[k + 1], l);
  550.         freq[k] := f;
  551.         move(son[k], son[k + 1], l);
  552.         son[k] := i;
  553.         i:=i+2;
  554.       end;
  555.     {*** connect parent nodes ***}
  556.     for i := 0 to T-1 do
  557.       begin
  558.         k := son[i];
  559.         if (k  >= T) then
  560.           begin
  561.             prnt[k] := i;
  562.           end
  563.         else
  564.           begin
  565.             prnt[k] := i;
  566.             prnt[k + 1] := i;
  567.           end;
  568.       end;
  569. end;
  570.  
  571.  
  572. {**** update freq tree ****}
  573.  
  574. procedure update(c:integer);
  575. var
  576.   i,j,k,l:integer;
  577. begin
  578.   if (freq[R] = MAX_FREQ) then
  579.         reconst;
  580.     c := prnt[c + T];
  581.  
  582.     repeat
  583.         freq[c]:=freq[c]+1;
  584.         k := freq[c];
  585.  
  586.         {**** swap nodes to keep the tree freq-ordered ****}
  587.         l := c+1;
  588.         if (k > freq[l]) then
  589.           begin
  590.             l:=l+1;
  591.             while (k > freq[l]) do l:=l+1;
  592.  
  593.             l := l-1;
  594.             freq[c] := freq[l];
  595.             freq[l] := k;
  596.  
  597.             i := son[c];
  598.             prnt[i] := l;
  599.             if (i < T) then prnt[i + 1] := l;
  600.  
  601.             j := son[l];
  602.             son[l] := i;
  603.  
  604.             prnt[j] := c;
  605.             if (j < T) then prnt[j + 1] := c;
  606.             son[c] := j;
  607.  
  608.             c := l;
  609.           end;
  610.         c := prnt[c];
  611.     until (c = 0);    {**** do it until reaching the root ****}
  612. end;
  613.  
  614.  
  615. procedure EncodeChar(c:word);
  616. var
  617.   i:word;
  618.   j,k:integer;
  619. begin
  620.     i := 0;
  621.     j := 0;
  622.     k := prnt[c + T];
  623.  
  624.     {**** search connections from leaf node to the root ****}
  625.     repeat
  626.         i := i shr 1;
  627.  
  628.         {/*
  629.         if node's address is odd, output 1
  630.         else output 0
  631.         */}
  632.  
  633.         if (k and 1)<>0 then
  634.           i := i + $8000;
  635.  
  636.         j:=j+1;
  637.         k:=prnt[k];
  638.     until (k = R);
  639.  
  640.     Putcode(j, i);
  641.     code := i;
  642.     len := j;
  643.     update(c);
  644. end;
  645.  
  646. procedure EncodePosition(c:word);
  647. var
  648.   i:word;
  649. begin
  650.     {**** output upper 6 bits with encoding ****}
  651.     i := c shr 6;
  652.     Putcode(p_len[i], word(p_code[i]) shl 8);
  653.  
  654.     {**** output lower 6 bits directly ****}
  655.     Putcode(6, (c and $3f) shl 10);
  656. end;
  657.  
  658.  
  659. procedure EncodeEnd;
  660. begin
  661.     if (putlen)<>0 then
  662.       begin
  663.         fwritebyte(putbuf shr 8);
  664.         codesize := codesize + 1;
  665.       end;
  666. end;
  667.  
  668. function DecodeChar:integer;
  669. var
  670.   c:word;
  671. begin
  672.     c := son[R];
  673.  
  674.     {/*
  675.      * start searching tree from the root to leaves.
  676.      * choose node #(son[]) if input bit == 0
  677.      * else choose #(son[]+1) (input bit == 1)
  678.      */}
  679.     while (c < T) do
  680.       begin
  681.         c := c + GetBit;
  682.         c := son[c];
  683.       end;
  684.     c := c - T;
  685.     update(c);
  686.     Decodechar:= c;
  687. end;
  688.  
  689. function DecodePosition:integer;
  690. var
  691.   i,j,c:word;
  692. begin
  693.  
  694.     {**** decode upper 6 bits from given table ****}
  695.     i := GetByte;
  696.     c := word(d_code[i]) shl 6;
  697.     j := d_len[i];
  698.  
  699.     {**** input lower 6 bits directly ****}
  700.     j := j - 2;
  701.     while (j<>0) do
  702.       begin
  703.         j:=j-1;
  704.         i := (i shl 1) + GetBit;
  705.       end;
  706.     j:=j-1;
  707.     DecodePosition := c or i and $3f;
  708. end;
  709.  
  710.  
  711. {**** Compression ****}
  712.  
  713. procedure Encode;  {**** Encoding/Compressing ****}
  714. var
  715.   i,c,len,r,s,last_match_length:integer;
  716. begin
  717.  
  718.     textsize := filesize(infile);
  719.  
  720.     fwritelong(textsize);
  721.     if (textsize = 0) then exit;
  722.  
  723.     seek(infile,0);
  724.  
  725.     textsize := 0;            {**** rewind and rescan ****}
  726.     StartHuff;
  727.     InitTree;
  728.     s := 0;
  729.     r := N - F;
  730.  
  731.     for i := s to  r-1 do
  732.       begin
  733.         text_buf[i] := 32;
  734.       end;
  735.  
  736.     len:=0;
  737.     while (len < F) and ( not eof(infile) ) do
  738.       begin
  739.         c:=freadbyte;
  740.         text_buf[r+len]:=c;
  741.         len := len+1;
  742.       end;
  743.  
  744.     textsize := len;
  745.     for i := F downto 1 do
  746.         InsertNode(r - i);
  747.     InsertNode(r);
  748.  
  749.     repeat
  750.         if (match_length > len) then  match_length := len;
  751.         if (match_length <= THRESHOLD) then
  752.           begin
  753.             match_length := 1;
  754.             EncodeChar(text_buf[r]);
  755.           end
  756.         else
  757.           begin
  758.             EncodeChar(255 - THRESHOLD + match_length);
  759.             EncodePosition((r-match_position-1)and (N-1));
  760.           end;
  761.         last_match_length := match_length;
  762.  
  763.         i:=0;
  764.         if i<last_match_length then
  765.           begin
  766.             while (i<last_match_length) and (not eof(infile)) do
  767.               begin
  768.                 c:=freadbyte;
  769.                 DeleteNode(s);
  770.                 text_buf[s] := c;
  771.                 if (s < F - 1) then
  772.                     text_buf[s + N] := c;
  773.                 s := (s + 1) and (N - 1);
  774.                 r := (r + 1) and (N - 1);
  775.                 InsertNode(r);
  776.                 i:=i+1;
  777.               end;
  778.           end;
  779.  
  780.         textsize:=textsize+i;
  781.         if (textsize > printcount) then
  782.           begin
  783.             write(textsize,' ');
  784.             printcount := printcount + 1024;
  785.           end;
  786.  
  787.         while (i < last_match_length) do
  788.           begin
  789.             i:=i+1;                             {*****chk here****}
  790.             DeleteNode(s);
  791.             s := (s + 1) and (N - 1);
  792.             r := (r + 1) and (N - 1);
  793.             len:=len-1;
  794.             if (len<>0) then InsertNode(r);
  795.           end;
  796.     until (len <= 0);
  797.  
  798.     EncodeEnd;
  799.  
  800.     writeln;
  801.     writeln('Pack size=',codesize, ' bytes');
  802. end;
  803.  
  804.  
  805. procedure Decode; {**** Decoding/Uncompressing ****}
  806. var
  807.   i,j,k,r,c:integer;
  808.   count:longint;
  809. begin
  810.  
  811.     freadlong(textsize);
  812.     if (textsize = 0) then
  813.         exit;
  814.     StartHuff;
  815.     for i := 0 to N-F-1 do
  816.         text_buf[i] := 32;
  817.     r := N - F;
  818.     count:=0;
  819.     while count<textsize do
  820.       begin
  821.         c := DecodeChar;
  822.         if (c < 256) then
  823.           begin
  824.             fwritebyte(c);
  825.             text_buf[r] := c;
  826.             r := r+1;
  827.             r := r and (N - 1);
  828.             count:=count+1;
  829.           end
  830.         else
  831.           begin
  832.             i := (r - DecodePosition - 1) and (N - 1);
  833.             j := c - 255 + THRESHOLD;
  834.             for k := 0 to j-1 do
  835.               begin
  836.                 c := text_buf[(i + k) and (N - 1)];
  837.                 fwritebyte(c);
  838.                 text_buf[r] := c;
  839.                 r :=r+1;
  840.                 r := r and (N - 1);
  841.                 count:=count+1;
  842.                end;
  843.           end;
  844.         if (count > printcount) then
  845.           begin
  846.             write(count,' ');
  847.             printcount := printcount + 1024;
  848.           end;
  849.       end;
  850.     writeln(count);
  851. end;
  852.  
  853.  
  854.  
  855.  
  856. procedure main;
  857. var
  858.   s:string;
  859. begin
  860.  
  861.     textsize   := 0;
  862.     codesize   := 0;
  863.     printcount := 0;
  864.     getbuf := 0;
  865.     getlen := 0;
  866.     putbuf := 0;
  867.     putlen := 0;
  868.     if (paramcount <> 3) then
  869.       begin
  870.         writeln('Usage:lzhuf e(compression)|d(uncompression) infile outfile');
  871.         halt;
  872.       end;
  873.     s:=paramstr(1);
  874.     if not (s[1] in ['D','E','d','e']) then halt;
  875.     assign(infile,paramstr(2));
  876.     reset(infile);
  877.  
  878.     assign(outfile,paramstr(3));
  879.     rewrite(outfile);
  880.  
  881.     s[1]:=upcase(s[1]);
  882.  
  883.     if s[1]='E' then
  884.         Encode
  885.     else
  886.         Decode;
  887.     close(infile);
  888.     close(outfile);
  889. end;
  890.  
  891. begin
  892.   main;
  893. end.
  894.